home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / printgrf / graphp.bas < prev    next >
Encoding:
BASIC Source File  |  1995-05-09  |  4.9 KB  |  117 lines
  1. Option Explicit
  2.    Type RECT
  3.       left As Integer
  4.       top As Integer
  5.       right As Integer
  6.       bottom As Integer
  7.    End Type
  8.     
  9.    Type Size
  10.       cx As Integer
  11.       cy As Integer
  12.    End Type
  13.    
  14.    Type POINTAPI
  15.       X As Integer
  16.       y As Integer
  17.    End Type
  18.    
  19.    Declare Function PlayMetafile% Lib "GDI" (ByVal hDC%, ByVal hmf%)
  20.    Declare Function SetMapMode Lib "GDI" (ByVal hDC As Integer, ByVal nMapMode As Integer) As Integer
  21.    Declare Function SetViewPortExt Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal y As Integer) As Long
  22.    Declare Function SetViewPortExtEx Lib "GDI" (ByVal hDC As Integer, ByVal nX As Integer, ByVal nY As Integer, lpSize As Size) As Integer
  23.    Declare Function SetViewPortOrg Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal y As Integer) As Long
  24.    Declare Function SetViewPortOrgEx Lib "GDI" (ByVal hDC As Integer, ByVal nX As Integer, ByVal nY As Integer, lpPoint As POINTAPI) As Integer
  25.    Declare Function ScaleViewPortExtEx% Lib "GDI" (ByVal hDC%, ByVal nXnum%, ByVal nXdenom%, ByVal nYnum%, ByVal nYdenom%, lpSize As Size)
  26.    Declare Function GetViewportExtEx Lib "GDI" (ByVal hDC As Integer, lpSize As Size) As Integer
  27.    Declare Function SetWindowExt Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal y As Integer) As Long
  28.    Declare Function SetWindowExtEx Lib "GDI" (ByVal hDC As Integer, ByVal nX As Integer, ByVal nY As Integer, lpSize As Size) As Integer
  29.    Declare Function SetWindowOrg Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal y As Integer) As Long
  30.    Declare Function SetWindowOrgEx Lib "GDI" (ByVal hDC As Integer, ByVal nX As Integer, ByVal nY As Integer, lpPoint As POINTAPI) As Integer
  31.    
  32.    Global Const MM_ISOTROPIC = 7
  33.  
  34. Function Printgraph (source As Control, originx As Integer, originy As Integer, rightx As Integer, bottomy As Integer) As Integer
  35.       
  36.     '*****************************************************************
  37.     '*  PrintGraph accepts parameters and then prints Graph or a picture
  38.     '*  containing a metafile to the printer
  39.     '*
  40.     '*     source  - accepts a Graph or picture control containing a
  41.     '*               metafile to be printed to the printer
  42.     '*
  43.     '*     originx, originy - specifies the x and y coordinates of the
  44.     '*                        origin of the output area (in Pixels)
  45.     '*
  46.     '*     rightx, bottomy - specifies the right and bottom of the
  47.     '*                       output area (in Pixels)
  48.     '*
  49.     '********************************************************************
  50.     Dim pagewidth%, pageheight%, oldmapmode%
  51.     Dim success%, ApiError%, successl&
  52.     Dim scalingx%, scalingy%
  53.     Dim lpold_vpextent As Size
  54.     Dim lpold_winextent As Size
  55.     Dim lpoldsize As Size
  56.     Dim lpDrawTextRect As RECT
  57.     Dim lpoldwindoworg  As POINTAPI
  58.     Dim lpoldvieworg  As POINTAPI
  59.     
  60.     
  61.     On Error GoTo handler
  62.  
  63.       ' Display hour glass:
  64.         screen.MousePointer = 11
  65.         ' Initialize the printer object's hDC from VB's perspective:
  66.         printer.Print " "
  67.         printer.ScaleMode = 3  ' pixels equivalent to MM_TEXT
  68.         pagewidth% = printer.ScaleWidth
  69.         pageheight% = printer.ScaleHeight
  70.         
  71.         scalingx = rightx - originx
  72.         scalingy = bottomy - originy
  73.         
  74.         oldmapmode% = SetMapMode(printer.hDC, MM_ISOTROPIC)
  75.         ' Make logical units equal to device units:
  76.         ' The SDK recommends that this be done when using MM_ISOTROPIC:
  77.         success% = SetWindowOrgEx(printer.hDC, 0, 0, lpoldwindoworg)
  78.         
  79.         
  80.         success% = SetWindowExtEx(printer.hDC, pagewidth%, pageheight%, lpold_winextent)
  81.         success% = SetViewPortOrgEx(printer.hDC, originx, originy, lpoldvieworg)
  82.         success% = SetViewPortExtEx(printer.hDC, 1, 1, lpold_vpextent)
  83.         success% = ScaleViewPortExtEx(printer.hDC, scalingx, 1, scalingy, 1, lpoldsize)
  84.         
  85.         
  86.         ' Send the metafile to the target hDC:
  87.         ApiError% = PlayMetafile(printer.hDC, source.Picture)
  88.         If ApiError% = 0 Then
  89.         MsgBox "PlayMetaFile failed"
  90.         Printgraph = False
  91.         End If
  92.         
  93.         ' Reset device context to initial values:
  94.         successl& = SetWindowOrg(printer.hDC, lpoldwindoworg.X, lpoldwindoworg.y)
  95.         successl& = SetWindowExt(printer.hDC, lpold_winextent.cx, lpold_winextent.cy)
  96.         successl& = SetViewPortOrg(printer.hDC, lpoldvieworg.X, lpoldvieworg.y)
  97.         successl& = SetViewPortExt(printer.hDC, lpold_vpextent.cx, lpold_vpextent.cy)
  98.         
  99.         oldmapmode% = SetMapMode(printer.hDC, oldmapmode%)
  100.         
  101.         Printgraph = True
  102.         
  103.         
  104.         screen.MousePointer = 0
  105.     Exit Function
  106.  
  107. handler:
  108.       
  109.       MsgBox "Function PrintMetafile has failed with error number " & Trim(Str(Err)) & " - recheck your parameters"
  110.  
  111.       screen.MousePointer = 0
  112.       Printgraph = False
  113.       Exit Function
  114.  
  115. End Function
  116.  
  117.